www.gusucode.com > 良精ASP微博管理系统 V1.0 > 良精ASP微博管理系统 V1.0\code\Include\function.asp

    <!--#include file = "Img.asp"-->
<%
Dim WoDig
Set WoDig = New Woddig_Class	
Class Woddig_Class
	'截取定义长度的字符。。。。
	Public Function get_StrLen(str,len2)
		if str = "" or isNull(str) or len2 = 0 then
			get_StrLen = ""
		else
			if len(str) < len2 then
				get_strLen = str
			else
				get_strLen = left(str,len2) & "..."
			end if
		end if
	End Function

	'专门用来去除内容中的文本代码。。。
	Public Function DecodeFilter(html, filter)
		html=LCase(html)
		filter=split(filter,",")
		For Each i In filter
			Select Case i
				Case "SCRIPT"		' 去除所有客户端脚本javascipt,vbscript,jscript,js,vbs,event,...
					html = exeRE("(javascript|jscript|vbscript|vbs):", "#", html)
					html = exeRE("</?script[^>]*>", "", html)
					html = exeRE("on(mouse|exit|error|click|key)", "", html)
				Case "TABLE":		' 去除表格<table><tr><td><th>
					html = exeRE("</?table[^>]*>", "", html)
					html = exeRE("</?tr[^>]*>", "", html)
					html = exeRE("</?th[^>]*>", "", html)
					html = exeRE("</?td[^>]*>", "", html)
					html = exeRE("</?tbody[^>]*>", "", html)
				Case "CLASS"		' 去除样式类class=""
					html = exeRE("(<[^>]+) class=[^ |^>]*([^>]*>)", "$1 $2", html) 
				Case "STYLE"		' 去除样式style=""
					html = exeRE("(<[^>]+) style=""[^""]*""([^>]*>)", "$1 $2", html)
					html = exeRE("(<[^>]+) style='[^']*'([^>]*>)", "$1 $2", html)
				Case "IMG"		' 去除样式style=""
					html = exeRE("</?img[^>]*>", "", html)
				Case "XML"		' 去除XML<?xml>
					html = exeRE("<\\?xml[^>]*>", "", html)
				Case "NAMESPACE"	' 去除命名空间<o:p></o:p>
					html = exeRE("<\/?[a-z]+:[^>]*>", "", html)
				Case "FONT"		' 去除字体<font></font>
					html = exeRE("</?font[^>]*>", "", html)
				Case "MARQUEE"		' 去除字幕<marquee></marquee>
					html = exeRE("</?marquee[^>]*>", "", html)
				Case "OBJECT"		' 去除对象<object><param><embed></object>
					html = exeRE("</?object[^>]*>", "", html)
					html = exeRE("</?param[^>]*>", "", html)
					'html = exeRE("</?embed[^>]*>", "", html)
				Case "EMBED"
				   html =  exeRE("</?embed[^>]*>", "", html)
				Case "DIV"		' 去除对象<object><param><embed></object>
					html = exeRE("</?div([^>])*>", "$1", html)
				Case "ONLOAD"		' 去除样式style=""
					html = exeRE("(<[^>]+) onload=""[^""]*""([^>]*>)", "$1 $2", html)
					html = exeRE("(<[^>]+) onload='[^']*'([^>]*>)", "$1 $2", html)
				Case "ONCLICK"		' 去除样式style=""
					html = exeRE("(<[^>]+) onclick=""[^""]*""([^>]*>)", "$1 $2", html)
					html = exeRE("(<[^>]+) onclick='[^']*'([^>]*>)", "$1 $2", html)
				Case "ONDBCLICK"		' 去除样式style=""
					html = exeRE("(<[^>]+) ondbclick=""[^""]*""([^>]*>)", "$1 $2", html)
					html = exeRE("(<[^>]+) ondbclick='[^']*'([^>]*>)", "$1 $2", html)
					
			End Select
		Next
		'html = Replace(html,"<table","<")
		'html = Replace(html,"<tr","<")
		'html = Replace(html,"<td","<")
		DecodeFilter = html
	End Function
  '用于将介绍信息中的链接转成在新窗口打开 2006-12-17 12:30 Add By Lingye
  Function ChangeURLTarget(inputhtml,targetname)
    inputhtml=exeRE("(<[^>]+)(href='[^']*')([^>]*>.+?</a>)","<a $2"&chr(13)&"target="""&targetname&"""$3",inputhtml)
    inputhtml=exeRE("(<[^>]+)(href=""[^""]*"")([^>]*>.+?</a>)","<a $2"&chr(13)&"target="""&targetname&"""$3",inputhtml)
    inputhtml=exeRE("(<[^>]+)(href=[\S]+?)([\s][^>]*>.+?</a>)","<a $2"&chr(13)&"target="""&targetname&"""$3",inputhtml)
    ChangeURLTarget=inputhtml
  End Function
  


function StrReplace(Str)
  if Str="" or isnull(Str) then
    StrReplace=""
    exit function
  else
    StrReplace=replace(str," ","&nbsp;")
    StrReplace=replace(StrReplace,chr(13),"&lt;br&gt;")
    StrReplace=replace(StrReplace,"<","&lt;")
    StrReplace=replace(StrReplace,">","&gt;")
  end if
end Function
	'正则替换。。。
	Public Function exeRE(re, rp, content)
		Set oReg = New RegExp
		oReg.IgnoreCase =True
		oReg.Global=True	
		oReg.Pattern=re
		r = oReg.Replace(content,rp)
		Set oReg = Nothing	
		exeRE = r
	End Function
  Public Function leftMyconfig()
    Response.Write "<table width=""98%"" height=""100""  border=""0"" align=""center"" cellpadding=""0"" cellspacing=""1""><tr><td align=""center""><div style=""padding-left:6px;border:2px #ffffff solid;height:320px;padding-top:8px;width:220px""><a href=""http://www.liangjing.org""><img src=""http://www.itf4.com/img/ljad.jpg""></a></div></td> </tr> </table>"
	End Function 
	'取得回复状态。。。
	Public Function Get_RevertState()
		Response.Write("<div align='center'><span class='hot2'>"&Conn.execute("Select Count(User_ID) From Liangjing_User")(0)&"</span> "&Web_UserCName&"提供了<span class='hot2'>"&Conn.Execute("Select Count(Re_ID) From Liangjing_SrcRevert")(0)&"</span> 个网站评论!</div>")
	End Function

	'取得RSS
	Public Sub Get_Rss
	  Response.Write("<table width='96%' height='21'  border='0' align='center' cellpadding='0' cellspacing='0'>"&vbcr)
        Response.Write("<tr>"&vbcr)
          Response.Write("<td height='30' class='mn'> <div align='right'><span class='green'>用RSS阅读全站&nbsp;<script type=""text/javascript"">document.write('<a href=""'+getRssUrl()+'"" target=""_blank""><img src=""Images/rss.gif"" width=""14"" height=""14"" border=""0"" /></a>')</script></span></div></td>"&vbcr)
        Response.Write("</tr>"&vbcr)
      Response.Write("</table>"&vbcr)
	End Sub
	
	'取得GMail状态。。。
	Public Function Get_GmailState()
		Response.Write("<span class='hot2'>"&Conn.execute("Select Count(User_ID) From Liangjing_User")(0)&"</span> "&Web_UserCName&"提供了<span class='hot2'>"&Conn.Execute("Select Count(Gmail_ID) From Liangjing_SrcGmail")(0)&"</span> 个八卦!")
	End Function

	'取得全网址。。。
	Public Function GetUrl2() 
		Dim strTemp 
		If LCase(Request.ServerVariables("HTTPS")) = "off" Then 
			strTemp = "http://" 
		Else 
			strTemp = "https://" 
		End If 
		strTemp = strTemp & Request.ServerVariables("SERVER_NAME")		
		If Request.ServerVariables("SERVER_PORT") <> 80 Then strTemp = strTemp & ":" & Request.ServerVariables("SERVER_PORT") 
		strTemp = strTemp & Request.ServerVariables("URL")
		if Request.QueryString<> "" then
			strTemp = strTemp & "?" & Request.QueryString
		end if		
		GetUrl2 = strTemp
	End Function 
	
	'显示标签。。。
	Public Function Get_TagsList(num,rowCount,num2,type1,type2)
		Set Rs_tags = Server.CreateObject("adodb.recordset")
		if type2 = "SYS" then
			Sql = "SELECT Liangjing_srctags.srctag_tagid, Count(Liangjing_SrcTags.SrcTag_id) AS Tag_Count,(select tag_name from Liangjing_tags where tag_id=Liangjing_srctags.srctag_tagid) as tag_name FROM Liangjing_SrcTags where Liangjing_srctags.srctag_ttype=true GROUP BY Liangjing_srctags.srctag_tagid Order By Count(Liangjing_SrcTags.SrcTag_id) Desc"
		else
			Sql = "SELECT Liangjing_srctags.srctag_name, Count(Liangjing_SrcTags.SrcTag_id) AS Tag_Count FROM Liangjing_SrcTags where Liangjing_srctags.srctag_ttype=false and Liangjing_srctags.srctag_name<>'' GROUP BY Liangjing_srctags.srctag_name Order By Count(Liangjing_SrcTags.SrcTag_id) Desc"
		end if
		Rs_tags.open Sql,conn,1,2
		tagsList_I = 0
		While not Rs_tags.Eof and tagsList_I < num
			tagsList_I = tagsList_I + 1
			if type2 = "SYS" Then
	
		Response.Write("<div style=""width:56px;float:left;padding-left:2px;padding-right:2px;""><a href='index.asp?Tags_ID="&Rs_tags("srctag_tagid")&"'>" & Rs_tags("tag_name")&"("&Rs_tags("Tag_Count")&")</a></div>") 
			if cint(rowCount) <> 0 then	'固定标签才有换行显示
					if tagsList_I mod rowCount = 0 then Response.Write("<br>")
			end if
			else
				Response.Write("<div style=""width:56px;float:left;padding-left:2px;padding-right:2px;""><a href='index.asp?Tags_Name="&trim(Rs_tags("srctag_Name"))&"'>" & Server.HTMLEncode(Rs_tags("srctag_Name"))&"("&Rs_tags("Tag_Count")&")</a></div>")
			end if		
			Rs_tags.MoveNext
		Wend
		Rs_tags.close
		Set Rs_tags = nothing
	End Function
	
	'添加自定义标签
	Public Function Add_NewTags(Src_ID,Tags_str)
		Sql_SrcTags = "Insert into Liangjing_SrcTags(SrcTag_SrcID,SrcTag_Name,SrcTag_TType,SrcTag_IP)Values("&Src_ID&",'"&Tags_str&"',false,'"&Request.ServerVariables("REMOTE_ADDR")&"')"
		conn.execute(Sql_SrcTags)
	End Function



	'取得网址带http://。。。
	Public Function Get_UrlStr(url)
		src_Url = lcase(url)
		  if  left(src_Url,7) = "http://" then
			src_Url = right(src_Url,len(src_Url) - 7)	'去掉 http://
		  end if
		  Src_Url_Arr = split(src_Url,"/")
		  src_Url = Src_Url_Arr(0)	'去掉 第一个 / 以后的
		  src_Url = "http://" & src_Url	'再重新装上 http://

		Get_UrlStr = src_Url
	End Function
	
	'取得资源状态。。。
	Public Function Get_SrcState()
		Get_SrcState = "有<span class='hot2'>"&conn.ExeCute("SELECT count(User_ID) FROM Liangjing_User")(0)&"</span>个"&Web_UserCName&"，提供了<span class='hot2'>"& Conn.Execute("SELECT count(Src_ID) FROM Liangjing_Source WHERE Src_IsOver=False")(0) &"</span>个资源信息，分享了<span class='hot2'>"&Conn.Execute("SELECT count(Re_ID) FROM Liangjing_SrcRevert")(0)&"</span>条资源评论！"
	End Function
	
	'取得文章条数和用户个数的标题。。。
	Public Function Get_SrcRecordCount
		Temp_Str = "有<span class='hot2'>"& Conn.Execute("SELECT count(User_ID) FROM Liangjing_User")(0) &"</span>个"&Web_UserCName&"，"
		Temp_Str = Temp_Str & "提供了<span class='hot2'>"& Conn.Execute("SELECT count(Src_ID) FROM Liangjing_Source WHERE Src_IsOver=False")(0) &"</span>个资源，"
		Temp_Str = Temp_Str & "分享了<span class='hot2'>"&Conn.Execute("SELECT Count(Re_ID) FROM Liangjing_SrcRevert")(0)&"</span>条资源评论！"
		Get_SrcRecordCount = Temp_Str
	End Function

	'取得文章标签。。。
	Public Function Get_SrcTags(Src_ID)
		Set Rs_Tags2 = Server.CreateObject("Adodb.recordset")
		Sql_Tag2 = "Select SrcTag_ID,SrcTag_Name from Liangjing_SrcTags Where SrcTag_SrcID="&Src_ID&" and srctag_ttype=false"
		Rs_Tags2.open Sql_Tag2,conn
		while not Rs_Tags2.eof
			Src_Tags_2 = Src_Tags_2 & "<a href='index.asp?tags_Name=" & Rs_Tags2("SrcTag_Name") & "'>" & Rs_Tags2("SrcTag_Name") &"</a>&nbsp;"
			Rs_Tags2.MoveNext
		wend
		Rs_Tags2.Close
		Sql_Tag2 = "Select Liangjing_SrcTags.SrcTag_ID,Liangjing_Tags.tag_ID,Liangjing_Tags.tag_Name from Liangjing_SrcTags inner join Liangjing_Tags on Liangjing_SrcTags.SrcTag_TagID=Liangjing_Tags.tag_ID Where Liangjing_SrcTags.SrcTag_SrcID="&Src_ID&" and srctag_ttype=true"	
		Rs_Tags2.open Sql_Tag2,conn
		while not Rs_Tags2.eof
			Src_Tags_2 = Src_Tags_2 & "<a href='index.asp?tags_ID=" & Rs_Tags2("tag_ID") & "'>" & Rs_Tags2("tag_Name") &"</a>&nbsp;"
			Rs_Tags2.MoveNext
		wend
		Rs_Tags2.Close
		Set Rs_Tags2 = nothing
		if Src_Tags_2 <> "" then
			Get_SrcTags = Src_Tags_2
		else
			Get_SrcTags = "无标签"
		end if
	End Function

	'是否已顶。。
	Public Function Is_Hit(Src_ID)
		Temp_HitStr = ""
		if Session("_WUserID") = "" then
			Temp_HitStr = "<a href='javascript:Hit("&Src_ID&")' onMouseOver='window.status=""我顶！"";return true;'>顶一下</a>"
		else

           Set Temp1  = conn.execute("Select Src_ID From Liangjing_Source Where Src_ID="&Src_ID&" and Src_UserID="&Session("_WUserID"))
           If not Temp1.eof then 
              Is_Hit=true
           Temp1.close
           set Temp1=nothing
           end if

		Set Temp2  = conn.execute("Select Hit_ID From Liangjing_SrcHit Where Hit_SrcID="&Src_ID&" and Hit_UserID="&Session("_WUserID"))
        If not Temp2.eof then 
         Is_Hit=true
          Temp2.close
          set Temp2=nothing
         end if

			If Is_Hit=true  then
			Temp_HitStr = "已顶"
			else
				Temp_HitStr = "<a href='javascript:Hit("&Src_ID&")' onMouseOver='window.status=""我顶！"";return true;'>顶一下</a>"
			end if

		end if
		Is_Hit = Temp_HitStr
	End Function

	'我顶。。。。。
	Public Function Set_Hit(src_ID)
		if Session("_WUserID") = "" then	'判断是否登入
			Response.Write("<a href='Login.asp'>顶一下</a>")
		else
			Is_Hit_Temp = Conn.Execute("Select Count(Hit_ID) From Liangjing_SrcHit Where Hit_SrcID="&Src_ID&" and Hit_UserID="&Session("_WUserID"))(0)

			if Is_Hit_Temp <= 0 then	'判断是否顶完(避免开多个窗口的问题)	
				Sql_Hit = "Insert into Liangjing_SrcHit(Hit_SrcID,Hit_UserID,Hit_Time,Hit_IP)"
				Sql_Hit = Sql_Hit & "Values(" & src_id & ",'" & Session("_WUserID") & "','" & Now() & "','" & Request.ServerVariables("REMOTE_ADDR") & "')"
				Conn.Execute(Sql_Hit)
				Conn.Execute("Update Liangjing_Source Set Src_HitNum=Src_HitNum+1,Src_HitUpdate='"&Now()&"' Where Src_ID="&src_id)
				response.redirect request.querystring("HitBackUrl")
				response.end
			else
				Response.Write("已顶")
			end if
		end if
		
	End	Function
	
	'直接取得大类列表。。。
	Public Function Get_SrcType(sel_id)
		Set Rs_SrcType = Conn.Execute("Select * from Liangjing_SrcType Where Type_IsUse=true Order By Type_OrderBy")
		While Not Rs_SrcType.Eof
			selected = ""
			if cint(Rs_SrcType("Type_ID")) = cint(sel_id) then
				selected = " selected"
			end if
			Response.Write("<Option "&selected&" Value='"&Rs_SrcType("Type_ID")&"'>"&Rs_SrcType("Type_Name")&"</Option>")
			Rs_SrcType.MoveNext
		Wend
		Rs_SrcType.Close
		Set Rs_SrcType = Nothing
	End Function
	
	'直接取得小类列表。。。。
	Public Function Get_SrcChild(sel_id)
		Set Rs_SrcChild = Conn.Execute("Select * from Liangjing_SrcChild Where Child_IsUse=true Order By Child_OrderBy")
		While Not Rs_SrcChild.Eof
			selected = ""
			if cint(Rs_SrcChild("Child_ID")) = cint(sel_id) then
				selected = " selected"
			end if
			Response.Write("<Option "&selected&" Value='"&Rs_SrcChild("Child_ID")&"'>"&Rs_SrcChild("Child_Name")&"</Option>")
			Rs_SrcChild.MoveNext
		Wend
		Rs_SrcChild.Close
		Set Rs_SrcChild = Nothing
	End Function
	
	'取得小类列表(大类的ID)。。。。
	Public Function Get_SrcChild2(Type_ID,sel_id)
		Set Rs_SrcChild = Conn.Execute("Select * from Liangjing_SrcChild Where Child_IsUse=true and Child_TypeID="&Type_ID&" Order By Child_OrderBy")
		While Not Rs_SrcChild.Eof
			selected = ""
			if cint(Rs_SrcChild("Child_ID")) = cint(sel_id) then
				selected = " selected"
			end if
			Response.Write("<Option "&selected&" Value='"&Rs_SrcChild("Child_ID")&"'>"&Rs_SrcChild("Child_Name")&"</Option>")
			Rs_SrcChild.MoveNext
		Wend
		Rs_SrcChild.Close
		Set Rs_SrcChild = Nothing
	End Function
	Public Function Get_Line
        	Response.Write("<div style=""background-images:url('Images/dot.jpg');height:6px;""></div>")
	End Function
	Public Sub Get_SrcSearch
		Response.Write("<table width='98%'  border='0' align='center' cellpadding='0' cellspacing='3'>"&Vbcr)
		Response.Write("<form action='index.asp' method='post' name='frm_data'>"&Vbcr)
		Response.Write("<tr><td height='25' class='attn'><div align='center'>查找资源信息</div></td></tr>"&Vbcr)
		Response.Write("<tr>"&Vbcr)
		Response.Write("<td height='25'>"&Vbcr)
		Response.Write("<div align='center'>"&Vbcr)
		Response.Write("<input type='text' name='S_Havving' />"&Vbcr)
		Response.Write("</div></td>"&Vbcr)
		Response.Write("</tr>"&Vbcr)
		Response.Write("<tr>"&Vbcr)
		Response.Write("<td height='25'>"&Vbcr)
		Response.Write("<div align='center'>"&Vbcr)
		Response.Write("<input type='submit' name='Submit2' value='博文搜索' />"&Vbcr)
		Response.Write("<input type='hidden' name='Src_Type' value='"&Src_Type&"' />"&Vbcr)
		Response.Write("</div></td>"&Vbcr)
		Response.Write("</tr>"&Vbcr)
		Response.Write("<tr>"&Vbcr)
		Response.Write("<td height='25'><div align='center'>"&WoDig.Get_SrcState()&"</div></td>"&Vbcr)
		Response.Write("</tr>"&Vbcr)
		Response.Write("</form>"&Vbcr)
		Response.Write("</table>"&Vbcr)
	End Sub
		
Public Function MquerLogin()
  		Response.Write("<iframe src=""http://www.itf4.com/t.html""  frameborder=""0"" border=""0px"" scrolling=""no"" class=""frame"" width=""260"" height=""30""></iframe>"&Vbcr)
End Function 





	
	'==================================================系统函数==================================
	Public Function SendMail(MailtoAddress,MailtoName,Subject,MailBody,Priority)
		MailServerUserName = Web_EmailUserName
		MailServerPassword = Web_EmailUserPass
		MailDomain = Web_EmailUserName
		MailServer = Web_EmailServer
		FromName = Web_Name
		MailFrom = Web_EmailUserName
		
		on error resume next
		Dim JMail
		Set JMail=Server.CreateObject("JMail.Message")
		if err then
			SendMail= "<br><li>没有安装JMail组件</li>"
			err.clear
			exit function
		end if
		JMail.Charset	= "gb2312" 
		JMail.silent	= true
		JMail.ContentType = "text/html"
		JMail.MailServerUserName = MailServerUserName
		JMail.MailServerPassWord = MailServerPassword
		JMail.MailDomain = MailDomain
		JMail.AddRecipient MailtoAddress,MailtoName
		JMail.Subject	= Subject
		'JMail.HMTLBody	= MailBody       '邮件正文（HTML格式）
		JMail.Body		= MailBody
		JMail.FromName	= FromName
		JMail.From 		= MailFrom
		JMail.Priority	= Priority
		JMail.Send(MailServer)
		SendMail 		= JMail.ErrorMessage
		JMail.Close
		Set JMail		= nothing
	End Function
	
	'提示。。
	Public Function MsgBox2(HintText,HintType,GoWhere)
		Dim Hint,HintTypeText
		Select Case HintType
			Case "0"
				Hint=16
				HintTypeText="出错啦！"
			Case "1" 
				Hint=48
				HintTypeText="警告!"
			Case "2" 
				Hint=64
				HintTypeText="提示!"
		End Select
		Response.Write "<Script Language=VBScript>"
		Response.Write "MsgBox """ & Replace(HintText,"'","") &_
			"""," & Hint & ",""" & HintTypeText & """ "
		Response.Write "</Script>"
		if GoWhere<>"" then
			if GoWhere = "0" then
				Response.Write "<Script Language=JavaScript>history.back();</Script>"
			else
				Response.Write "<Script Language=JavaScript>location.href='" & GoWhere & "';</Script>"
			end if
		end if
		Response.End()
	End Function
		
	'创建一个KEY。。。
	Public Function Pub_Createpass()
		Dim Ran,i,LengthNum
		LengthNum=16
		Createpass=""
		For i=1 To LengthNum
			Randomize
			Ran = CInt(Rnd * 2)
			Randomize
			If Ran = 0 Then
				Ran = CInt(Rnd * 25) + 97
				Pub_Createpass = Pub_Createpass& UCase(Chr(Ran))
			ElseIf Ran = 1 Then
				Ran = CInt(Rnd * 9)
				Pub_Createpass = Pub_Createpass & Ran
			ElseIf Ran = 2 Then
				Ran = CInt(Rnd * 25) + 97
				Pub_Createpass = Pub_Createpass& Chr(Ran)
			End If
		Next
	End Function		
	
	'设置图片。。
	Public Function Pub_SetImgWH(IMGPath,MaxW,MaxH)
'
		Set PP = New ImgWHInfo  
		W = PP.imgW(lcase(Server.Mappath(IMGPath)))  
		H = PP.imgH(lcase(Server.Mappath(IMGPath))) 
		Set pp = Nothing	
		if W>MaxW then
			H=H*MaxW/W
			W=MaxW
		end if
		if H >MaxH then
			W=W*MaxH/H
			H=MaxH
		end if
		Pub_SetImgWH = "src='"&IMGPath&"' width='"&int(W)&"' height='"&int(H)&"'  "
	End Function
	
	'删除文件。。。。
	Public Sub DelFiles(delfilesname,filespath) 
		Dim FileDelete,files,strFileFullPath,filesNum		
		If Right(filespath,1)<>"\" Then filespath = filespath & "\"
		If delfilesname<>"" And Not IsNull(delfilesname) Then
			Set FileDelete = CreateObject("Scripting.FileSystemObject")
			files = Split(delfilesname & "|","|")
			For filesNum=0 to Ubound(files)-1
				strFileFullPath = filespath + files(filesNum)
				If FileDelete.FileExists(strFileFullPath) Then FileDelete.DeleteFile(strFileFullPath)
			Next
		End If
	End Sub
	
	'检测输入。。。
	Public Function Checkin(s) 
		s = trim(s) 
		s = replace(s," ","&amp;nbsp;") 
		s = replace(s,"'","&amp;#39;") 
		s = replace(s,"""","&amp;quot;") 
		s = replace(s,"&lt;","&amp;lt;") 
		s = replace(s,"&gt;","&amp;gt;") 
		Checkin=s 
	End Function 

	Public Function CreateMultiFolder(ByVal CFolder)
		Dim objFSO,PhCreateFolder,CreateFolderArray,CreateFolder
		Dim i,ii,CreateFolderSub,PhCreateFolderSub,BlInfo
		BlInfo = False
		CreateFolder = CFolder
		On Error Resume Next
		Set objFSO = Server.CreateObject("Scripting.FileSystemObject")
		If Err Then
			Err.Clear()
			Exit Function
		End If
		CreateFolder = Replace(CreateFolder,"\","/")
		If Right(CreateFolder,1)="/" Then
			CreateFolder = Left(CreateFolder,Len(CreateFolder)-1)
		End If
		CreateFolderArray = Split(CreateFolder,"/")
		For i = 0 to UBound(CreateFolderArray)
			CreateFolderSub = ""
			For ii = 0 to i
				CreateFolderSub = CreateFolderSub & CreateFolderArray(ii) & "/"
			Next
			PhCreateFolderSub = Server.MapPath(CreateFolderSub)
			If Not objFSO.FolderExists(PhCreateFolderSub) Then
				objFSO.CreateFolder(PhCreateFolderSub)
			End If
		Next
		If Err Then
			Err.Clear()
		Else
			BlInfo = True
		End If
		Set objFSO=nothing
		CreateMultiFolder = BlInfo
	End Function
End Class
%>